home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTINPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  32KB  |  1,252 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10a                            }
  6.  
  7. Unit totINPUT;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.        1.00a  3/28/91   Add Mouse method SetForceOff to stop Toolkit
  13.                         making the mouse visible;
  14.        1.00b  5/23/91   Corrected ret codes with Mouse method 1
  15.        1.00c  6/02/91   Changed Shiftpressed check for XT's
  16.        1.00d  7/23/91   Replaced CRT Readkey with interrupt to better
  17.                         support extended clone keyboards.
  18.        1.00e  8/17/91   Allowed keyboard stuffing in the idle hook.
  19.        1.00f  2/03/92   Added SetSlowdelay method
  20.        1.00g  3/09/92   Added support for vSetLeft
  21.        1.10   12/15/92  DPMI Update
  22.        1.10a  02/29/93  Corrected extended keyboard recognition problem
  23.        1.10b  05/03/93  Improved Double-Click reponse on fast systems --
  24.                         thanks Arnold!
  25.                         Added MouseOBJ.WaitForRelease method
  26. }
  27.  
  28.  
  29. INTERFACE
  30.  
  31. {$IFDEF DPMI}
  32. uses DOS,CRT,WINAPI;
  33. {$ELSE}
  34. uses DOS,CRT;
  35. {$ENDIF}
  36.  
  37. Const
  38.     StuffBufferSize = 30;
  39.  
  40. Type
  41.  
  42. InputIdleProc    = procedure;
  43. InputPressedProc = procedure(var W:word);
  44. CharProc         = procedure(W:word);
  45. CaseFunc         = function(Ch:char):char;
  46. CharSet = set of char;
  47.  
  48. pAlphabetOBJ = ^AlphabetOBJ;
  49. AlphabetOBJ = object
  50.    vUpper: CharSet;
  51.    vLower: CharSet;
  52.    vPunctuation: CharSet;
  53.    vUpCaseFunc: CaseFunc;
  54.    vLoCaseFunc: CaseFunc;
  55.    {methods...}
  56.    constructor Init;
  57.    procedure   AssignUpCaseFunc(Func:caseFunc);
  58.    procedure   AssignLoCaseFunc(Func:caseFunc);
  59.    procedure   SetUpper(Letters:CharSet);
  60.    procedure   SetLower(Letters:CharSet);
  61.    procedure   SetPunctuation(Letters:CharSet);
  62.    function    IsUpper(K:word): boolean;
  63.    function    IsLower(K:word): boolean;
  64.    function    IsLetter(K:word): boolean;
  65.    function    IsPunctuation(K:word): boolean;
  66.    function    GetUpCase(Ch:char):char;
  67.    function    GetLoCase(Ch:char):char;
  68.    destructor  Done;
  69. end; {AlphabetOBJ}
  70.  
  71. pMouseOBJ = ^MouseOBJ;
  72. MouseOBJ = object
  73.    vInstalled: boolean;    {is the system equipped with a mouse}
  74.    vButtons: byte;         {how many buttons on mouse}
  75.    vLeftHanded: boolean;   {is right button Enter?}
  76.    vIntr: integer;         {mouse interrupt number}
  77.    vVisible: boolean;      {is mouse cursor visible?}
  78.    vForceNoMouse: boolean; {uses monochrome color schemes}
  79.    {methods}
  80.    constructor Init;
  81.    procedure   SetLeft(On:boolean);
  82.    function    LeftHanded:boolean;
  83.    function    AdjustedButton(Button:integer):integer;
  84.    procedure   SetForceOff(On:boolean);
  85.    procedure   Reset;
  86.    function    Installed:boolean;
  87.    procedure   CheckInstalled;
  88.    procedure   Show;
  89.    procedure   Hide;
  90.    procedure   Move(X,Y : integer);
  91.    procedure   Confine(X1,Y1,X2,Y2:integer);
  92.    function    Released(Button: integer; var X,Y: byte): byte;
  93.    function    Pressed(Button: integer; var X,Y: byte): byte;
  94.    function    InZone(X1,Y1,X2,Y2: byte):boolean;
  95.    procedure   Location(var X,Y : byte);
  96.    procedure   Status(var L,C,R:boolean; var X,Y : byte);
  97.    procedure   WaitForRelease;
  98.    function    Visible: boolean;
  99.    procedure   SetMouseCursorStyle(OrdChar,Attr:byte);
  100.    function    GetButtons: byte;
  101.    destructor  Done;
  102. end; {MouseOBJ}
  103.  
  104. pKeyOBJ = ^KeyOBJ;
  105. KeyOBJ = object
  106.    vMouseMethod: byte;        {0-no mouse, 1-cursor emulation, 2-freefloating mouse}
  107.    vBuffer: array[1..StuffBufferSize] of word;
  108.    vBufferHead: word;         {next character from buffer}
  109.    vBufferTail:word;          {last valid character in buffer}
  110.    vLastkey: word;            {the last key pressed}
  111.    vLastX:byte;               {location of mouse when button pressed}
  112.    vLastY:byte;               {                -"-                  }
  113.    vClick: boolean;           {click after every keypress?}
  114.    vHorizSensitivity: byte;   {no of characters}
  115.    vVertSensitivity: byte;    {      -"-       }
  116.    vWaitForDouble: boolean;
  117.    vIdleHook: InputIdleProc;
  118.    vPressedHook: InputPressedProc;
  119.    vExtended : boolean;       {is it an extended keyboard}
  120.    vButtons : byte;
  121.    vSlowdelay: integer;       {time to wait for double click}
  122.    vLastPress: longint;
  123.    {methods...}
  124.    constructor Init;
  125.    procedure   SetSlowDelay(Del:integer);
  126.    procedure   AssignIdleHook(PassedProc: InputIdleProc);
  127.    procedure   AssignPressedHook(PassedProc: InputPressedProc);
  128.    function    Extended: boolean;
  129.    procedure   SetCaps(On:boolean);
  130.    procedure   SetNum(On:boolean);
  131.    procedure   SetScroll(On:boolean);
  132.    function    GetCaps:boolean;
  133.    function    GetNum:boolean;
  134.    function    GetScroll:boolean;
  135.    procedure   SetRepeatRate(Delay,Rate:byte);
  136.    procedure   SetFast;
  137.    procedure   SetSlow;
  138.    procedure   SetMouseMethod(Method:byte);
  139.    procedure   SetClick(On: boolean);
  140.    procedure   SetDouble(On:boolean);
  141.    function    GetDouble:boolean;
  142.    procedure   Click;
  143.    procedure   SetHoriz(Sensitivity:byte);
  144.    procedure   SetVert(Sensitivity:byte);
  145.    procedure   GetInput;
  146.    function    LastKey: word;
  147.    function    LastChar: char;
  148.    function    LastX: byte;
  149.    function    LastY: byte;
  150.    function    ExtendedKey(var K:byte):boolean;
  151.    function    ReadKey: char;
  152.    function    GetKey: word;
  153.    procedure   FlushBuffer;
  154.    procedure   StuffBuffer(W:word);
  155.    procedure   StuffBufferStr(Str:string);
  156.    function    Keypressed: boolean;
  157.    procedure   DelayKey(Mills:longint);
  158.    function    AltPressed:boolean;
  159.    function    CtrlPressed:boolean;
  160.    function    LeftShiftPressed: boolean;
  161.    function    RightShiftPressed: boolean;
  162.    function    ShiftPressed: boolean;
  163.    destructor  Done;
  164. end; {KeyOBJ}
  165.  
  166. procedure NoInputIdleHook;
  167. procedure NoInputPressedHook(var W:word);
  168. function  Altkey(K: word): word;
  169. procedure inputINIT;
  170.  
  171. VAR
  172.    AlphabetTOT: ^AlphabetOBJ;
  173.    Mouse: MouseOBJ;
  174.    Key:   KeyOBJ;
  175.  
  176. IMPLEMENTATION
  177. var
  178.    KeyStatusBits : ^word; {1.10}
  179.  
  180. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  181. {                                                               }
  182. {     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
  183. {                                                               }
  184. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  185.  
  186. {$F+}
  187.  procedure NoInputIdleHook;
  188.  {empty procs}
  189.  begin end; {NoInputIdleHook}
  190.  
  191.  procedure NoInputPressedHook(var W:word);
  192.  {empty procs}
  193.  begin end; {NoInputPressedHook}
  194.  
  195.  function EnglishUpCase(Ch:char):char;
  196.  {}
  197.  begin
  198.     EnglishUpCase := upcase(Ch);
  199.  end; {EnglishUpCase}
  200. (*
  201.  inline($58/$3C/$61/$72/$39/$3C/$7A/$76/$33/$3C/$84/$75/$02/$B0/$8E
  202.  /$3C/$94/$75/$02/$B0/$99/$3C/$81/$75/$02/$B0/$9A
  203.  /$3C/$87/$75/$02/$B0/$80/$3C/$86/$75/$02/$B0/$BF
  204.  /$3C/$82/$75/$02/$B0/$90/$3C/$91/$75/$02/$B0/$92
  205.  /$3C/$A4/$75/$02/$B0/$A5/$EB/03/90/$2C/$20);
  206. *)
  207.  function EnglishLoCase(Ch:char):char;
  208.  {}
  209.  begin
  210.    if Ch in ['A'..'Z'] then
  211.       EnglishLoCase := chr(ord(Ch) + 32)
  212.    else
  213.       EnglishLoCase := Ch;
  214.  end; {EnglishLoCase}
  215.  (*
  216.  inline($58/$3C/$41/$72/$39/$3C/$5A/$76/$33/$3C/$8E/$75/$02/$B0/$B4
  217.  /$3C/$99/$75/$02/$B0/$94/$3C/$9A/$75/$02/$B0/$81
  218.  /$3C/$8D/$75/$02/$B0/$87/$3C/$8F/$75/$02/$B0/$86
  219.  /$3C/$9D/$75/$02/$B0/$82/$3C/$92/$75/$02/$B0/$91
  220.  /$3C/$A5/$75/$02/$B0/$A4/$EB/03/90/$04/$20);
  221.  *)
  222. {$F-}
  223.  
  224. function Altkey(K: word): word;
  225. {returns the Alt keycode equivalent of a number or letter}
  226. var AK: word;
  227. begin
  228.    Case K of
  229.       65:AK:=286; 66:AK:=304; 67:AK:=302; 68:AK:=288; 69:AK:=274; 70:AK:=289;
  230.       71:AK:=290; 72:AK:=291; 73:AK:=279; 74:AK:=292; 75:AK:=293; 76:AK:=294;
  231.       77:AK:=306; 78:AK:=305; 79:AK:=280; 80:AK:=281; 81:AK:=272; 82:AK:=275;
  232.       83:AK:=287; 84:AK:=276; 85:AK:=278; 86:AK:=303; 87:AK:=273; 88:AK:=301;
  233.       89:AK:=277; 90:AK:=300; 48:AK:=385;
  234.    else if (K >= 49) and (K <= 57) then
  235.            AK := K + 327
  236.         else 
  237.            AK